home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tool-inc.zip
/
DAYSAFTR.INC
< prev
next >
Wrap
Text File
|
1989-12-31
|
1KB
|
63 lines
(* --------------------------------------------------------- *)
procedure determine_last_date(days: integer);
(* determine first_date as n days before today *)
var
year: word;
month: word;
day: word;
dow: word;
procedure itoa2(i: integer; var sp);
var
s: array[1..2] of char absolute sp;
begin
s[1] := chr( (i div 10) + ord('0'));
s[2] := chr( (i mod 10) + ord('0'));
end;
const
monthdays: array[1..12] of integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
begin
{ get today's date from DOS }
GetDate(year,month,day,dow);
year := year - 1900;
{ advance N days }
while (days > 0) do
begin
dec(days);
if (day < monthdays[month]) then
inc(day)
else
if (month < 12) then
begin
inc(month);
day := 1;
end
else
begin
inc(year);
month := 1;
day := 1;
end;
end;
{ format the date for comparison }
{ itoa2(year,firstdate[1]);
itoa2(month,firstdate[3]);
itoa2(day,firstdate[5]); }
writeln('Final date is ',month,'-',day,'-',year);
end;